home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / dired-shell.el.z / dired-shell.el
Encoding:
Text File  |  1998-05-21  |  29.6 KB  |  862 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;
  3. ;; File:          dired-shell.el
  4. ;; Dired Version: #Revision: 7.9 $
  5. ;; RCS:
  6. ;; Description:   Commands for running shell commands on marked files.
  7. ;;
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9.  
  10. ;;; Requirements and provisions
  11. (provide 'dired-shell)
  12. (require 'dired)
  13. (autoload 'comint-mode "comint")
  14.  
  15. ;;; Variables
  16.  
  17. (defvar dired-postscript-print-command
  18.   (condition-case nil
  19.       (progn
  20.     (require 'ps-print)
  21.     (concat ps-lpr-command
  22.         " "
  23.         (ps-flatten-list (mapcar 'ps-eval-switch ps-lpr-switches))))
  24.     (error
  25.      (concat
  26.       (if (boundp 'lpr-command)
  27.       lpr-command
  28.     (if (memq system-type
  29.           '(usg-unix-v hpux silicon-graphics-unix))
  30.         "lp"
  31.       "lpr"))
  32.       (if (and (boundp 'lpr-switches) lpr-switches)
  33.       (concat " "
  34.           (mapconcat 'identity lpr-switches " ")
  35.           " ")
  36.     " "))))
  37.      "Command to print a postscript file.")
  38.  
  39. (defvar dired-text-print-command (concat dired-postscript-print-command "-p ")
  40.   "Command to print a text file.")
  41.  
  42. (defvar dired-print-program-alist
  43.   (list
  44.    (cons "\\.gif$" (concat "giftoppm * | ppmtopgm | pnmtops | "
  45.                dired-postscript-print-command))
  46.    (cons "\\.\\(fts\\|FTS\\)$" (concat "fitstopgm * | pnmtops | "
  47.                        dired-postscript-print-command))
  48.    ;; People with colour printers won't want the g-flag in djpeg
  49.    (cons "\\.\\(JPG\\|jpg\\)$" (concat "djpeg -Pg * | pnmtops | "
  50.                        dired-postscript-print-command))
  51.    (cons "\\.ps\\.\\(gz\\|Z\\)$" (concat "zcat * | "
  52.                      dired-postscript-print-command))
  53.    (cons "\\.ps$" dired-postscript-print-command)
  54.    (cons "\\.\\(gz\\|Z\\)$" (concat "zcat * | "
  55.                     dired-postscript-print-command))
  56.    (cons "\\.dvi$" "dvips")
  57.    (cons ".*" dired-text-print-command))
  58.   "Alist of regexps and print commands.
  59. This is used by `dired-do-print' to determine the default print command for
  60. printing the marked files.")
  61.  
  62. (defvar dired-auto-shell-command-alist nil
  63.   "*Alist of regexps and command lists to guess shell commands.
  64. Each element of this list should be a list of regular expression, and a list
  65. of guesses for shell commands to be used if the file name matches the regular
  66. expression. The list of guesses is evalled. This alist is appended to the front
  67. of dired-default-auto-shell-command-alist before prompting for each shell
  68. command.")
  69.  
  70. (defvar dired-default-auto-shell-command-alist
  71.   (list
  72.  
  73.    ;; Archiving
  74.    '("\\.tar$"
  75.      (if dired-gnutar-program
  76.      (concat dired-gnutar-program " xvf")
  77.        "tar xvf")
  78.      (if dired-gnutar-program
  79.      (concat dired-gnutar-program " tvf")
  80.        "tar tvf"))
  81.    ;; regexps for compressed archives must come before the .Z rule to
  82.    ;; be recognized:
  83.    '("\\.tar\\.\\([zZ]\\|gz\\)\\|\\.tgz$" ; .tgz is for DOS
  84.      (if dired-gnutar-program
  85.      (concat dired-gnutar-program " zxvf")
  86.        "zcat * | tar xvf -")
  87.      (if dired-gnutar-program
  88.      (concat dired-gnutar-program " ztvf")
  89.        "zcat * | tar tvf -"))
  90.    '("\\.shar.[zZ]$" (if dired-unshar-program
  91.              (concat "zcat * | " dired-unshar-program)
  92.                "zcat * | sh"))
  93.    '("\\.zoo$" "zoo x//")
  94.    '("\\.zip$" "unzip" "unzip -v")
  95.    '("\\.lzh$" "lharc x")
  96.    '("\\.arc$" "arc x")
  97.    '("\\.shar$" (if dired-unshar-program dired-unshar-program "sh"))
  98.  
  99.    ;; Encoding/compressing
  100.    '("\\.uu$" "uudecode")
  101.    '("\\.hqx$" "mcvert")
  102.  
  103.    ;; Executing (in the generalized sense)
  104.    '("\\.sh$" "sh")            ; execute shell scripts
  105.    '("^[Mm]akefile$" "make -f *")
  106.    '("\\.diff$" "patch -t <")
  107.  
  108.    ;; Displaying (assumes X)
  109.    '("\\.xbm$" "bitmap")        ; view X11 bitmaps
  110.    '("\\.gp$" "gnuplot")
  111.    '("\\.gif$" "xv")            ; view gif pictures
  112.    '("\\.fig$" "xfig")            ; edit fig pictures
  113.    '("\\.ps$" "ghostview")
  114.  
  115.    ;; Typesetting.  For printing documents, see dired-print-program-alist.
  116.    '("\\.tex$" "latex" "tex")
  117.    '("\\.texi\\(nfo\\)?$" "makeinfo" "texi2dvi")
  118.    (if (eq window-system 'x)
  119.        (if dired-use-file-transformers
  120.        '("\\.dvi$"  "xdvi" "dvips -o *b.ps *")
  121.      '("\\.dvi$" "xdvi" "dvips"))
  122.      (if dired-use-file-transformers
  123.      '("\\.dvi$" "dvips -o *b.ps *")
  124.        '("\\.dvi$" "dvips")))
  125.  
  126.    ;; The last word.  Things that cannot be grokked with a regexp.
  127.    '("." (if (> (length files) 1)
  128.          "tar cvf "
  129.        (and (= (length files) 1) (file-directory-p
  130.                       (expand-file-name
  131.                        (car files)
  132.                        (dired-current-directory)))
  133.         (concat "tar cvf " (file-name-nondirectory
  134.                     (directory-file-name (car files)))
  135.             ".tar"))))
  136.    )
  137.   "Default for variable `dired-auto-shell-command-alist' (which see).
  138. Set this to nil to turn off shell command guessing.")
  139.  
  140. ;; Might use {,} for bash or csh:
  141. (defvar dired-shell-prefix ""
  142.   "Prepended to marked files in dired shell commands.")
  143. (defvar dired-shell-postfix ""
  144.   "Appended to marked files in dired shell commands.")
  145. (defvar dired-shell-separator " "
  146.   "Separates marked files in dired shell commands.")
  147.  
  148. (defvar dired-file-wildcard ?*
  149.   "Wildcard character used by dired shell commands.
  150. Indicates where file names should be inserted.")
  151.  
  152. (defvar dired-shell-command-separators '(?\  ?| ?> ?< ?& ?;)
  153.   "Defines the start of a string specifying a word in a shell command.")
  154.  
  155. (defvar dired-trans-map
  156.   (list
  157.    (cons ?f 'identity)
  158.    (cons ?n 'file-name-nondirectory)
  159.    (cons ?d 'file-name-directory)
  160.    (cons ?b 'dired-file-name-base)
  161.    (cons ?e 'dired-file-name-extension)
  162.    (cons ?v 'dired-file-name-sans-rcs-extension)
  163.    (cons ?z 'dired-file-name-sans-compress-extension))
  164.   "Alist that associates keys with file transformer functions
  165. Each transformer function should be a funcion of one argument, the file name.
  166. The keys are characters.")
  167.  
  168. (defvar dired-shell-failure-marker ?!
  169.   "*A marker to mark files on which shell commands fail.
  170. If nil, such files are not marked.")
  171.  
  172. ;;; Internal variables
  173.  
  174. ;; Make sure this gets defined.
  175. (defvar shell-command-history nil
  176.   "History list of previous shell commands.")
  177.  
  178. (defvar dired-print-history nil
  179.   "History of commands used to print files.")
  180.  
  181. (defvar dired-shell-input-start) ; only defined in shell output buffers
  182.  
  183. ;;; Utility functions and Macros
  184.  
  185. (defun dired-shell-quote (filename)
  186.   ;; Quote a file name for inferior shell (see variable shell-file-name).
  187.   ;; Quote everything except POSIX filename characters.
  188.   ;; This should be safe enough even for really weird shells.
  189.   (let ((result "") (start 0) end)
  190.     (while (string-match "[^---0-9a-zA-Z_./]" filename start)
  191.       (setq end (match-beginning 0)
  192.         result (concat result (substring filename start end)
  193.                "\\" (substring filename end (1+ end)))
  194.         start (1+ end)))
  195.     (concat result (substring filename start))))
  196.  
  197. (defun dired-uniquefy-list (list)
  198.   ;; Returns list, after removing 2nd and higher occurrences
  199.   ;; of all elements. Tests elements with equal. Retains the relative
  200.   ;; order of the elements.
  201.   ;; For small lists, this way is probably faster than sorting.
  202.   (let (result)
  203.     (while list
  204.       (or (member (car list) result)
  205.       (setq result (nconc result (list (car list)))))
  206.       (setq list (cdr list)))
  207.     result))
  208.  
  209. (defun dired-read-shell-command (prompt arg files)
  210.   ;; Read a dired shell command prompting with PROMPT (using read-string).
  211.   ;; ARG is the prefix arg and may be used to indicate in the prompt which
  212.   ;;  files are affected.
  213.   (dired-mark-pop-up
  214.    nil 'shell files
  215.    (function
  216.     (lambda (prompt files)
  217.       (let* ((default (car shell-command-history))
  218.          (guesses (dired-guess-default files))
  219.          (len (length guesses))
  220.          cmd)
  221.     (or (zerop len)
  222.         (setq prompt (format "%s{%d guess%s} "
  223.                  prompt len (if (= len 1) "" "es"))))
  224.     (if default (setq prompt (concat prompt "[" default "] ")))
  225.     (put 'guesses 'no-default t) ; for gmhist, in case.
  226.     (setq guesses (nconc guesses (copy-sequence shell-command-history))
  227.           cmd (dired-read-with-history prompt nil 'guesses))
  228.     (if (string-match "^[ \t\n]*$" cmd)
  229.         (if default
  230.         (setq cmd default)
  231.           (error "No shell command given.")))
  232.     (setq shell-command-history
  233.           (dired-uniquefy-list
  234.            (cons cmd shell-command-history)))
  235.     cmd)))
  236.    (format prompt (dired-mark-prompt arg files)) files))
  237.  
  238. (defmacro dired-trans-subst (transformers filename dir)
  239. ;; Applies each transformer supplied in the string TRANSFORMERS in sequence
  240. ;; to FILE and returns the concatenation of the results. Also unquotes \\'s.
  241. ;; Returns a string if no file transformations were done, otherwise a list
  242. ;; consisting of a single string.
  243.   (` (let* ((transformers (, transformers))
  244.         (filename (, filename))
  245.         (len (length transformers))
  246.         (pos 0)
  247.         (last 0)
  248.         (transformed nil)
  249.         (quoted nil)
  250.         char result trans)
  251.        (while (< pos len)
  252.      (setq char (aref transformers pos))
  253.      (cond
  254.       (quoted (setq pos (1+ pos)
  255.             quoted nil))
  256.       ((= ?\\ char)
  257.        (setq quoted t
  258.          result (concat result (substring transformers last pos))
  259.          pos (1+ pos)
  260.          last pos))
  261.       ((and (null quoted) (= char dired-file-wildcard))
  262.        (setq pos (1+ pos)
  263.          trans (and (< pos len)
  264.                 dired-use-file-transformers
  265.                 (assq (aref transformers pos)
  266.                   dired-trans-map))
  267.          transformed t)
  268.        (if trans
  269.            (setq result (concat result
  270.                     (substring transformers last (1- pos))
  271.                     (funcall (cdr trans) filename))
  272.              pos (1+ pos)
  273.              last pos)
  274.          (setq result (concat result (substring transformers last (1- pos))
  275.                   (dired-make-relative filename (, dir) t))
  276.            last pos)))
  277.       ((setq pos (1+ pos)))))
  278.        (if result
  279.        (progn
  280.          (setq result (dired-shell-quote
  281.                (concat result (substring transformers last))))
  282.          (if transformed (list result) result))
  283.      transformers))))
  284.  
  285. (defun dired-trans-filenames (transformers files dir)
  286.   ;; Applies a transformer string to a list of filenames,
  287.   ;; concatenating them into a string. The result will be prefixed
  288.   ;; by dired-shell-prefix, the filenames separated by dired-shell-separator,
  289.   ;; and postfixed by dired-shell-postfix.
  290.   ;; Returns a list if filename subst. was done. A string otherwise.
  291.   (let ((list files)
  292.     (res nil)
  293.     trans)
  294.     (while list
  295.       (setq trans (dired-trans-subst transformers (car list) dir))
  296.       (if (listp trans)
  297.       (setq res (nconc res trans)
  298.         list (cdr list))
  299.     (setq res trans
  300.           list nil)))
  301.     (if (listp res)
  302.     (list
  303.      (if (> (length files) 1)
  304.          (concat dired-shell-prefix
  305.              (mapconcat 'identity res dired-shell-separator)
  306.              dired-shell-postfix)
  307.        (car res)))
  308.       res)))
  309.  
  310. (defun dired-trans-command (command files dir)
  311.   ;; Do all of the trans substitutions in COMMAND for the list
  312.   ;; of files FILES. FILES must be a list of *absolute* pathnames.
  313.   ;; DIR is an absolute directory wrto which filenames may be relativized.
  314.   (let ((len (length command))
  315.     (start 0)
  316.     (pos 0)
  317.     (last 0)
  318.     result char transed transform)
  319.     (while (< pos len)
  320.       ;; read over word separators.
  321.       (while (and (< pos len) (memq (aref command pos)
  322.                  dired-shell-command-separators))
  323.     (setq pos (1+ pos)))
  324.       (setq start pos)
  325.       ;; read a word
  326.       (while (and (< pos len) (not (memq (setq char (aref command pos))
  327.                      dired-shell-command-separators)))
  328.     (setq pos (1+ pos))
  329.     ;; look out for quoted separators
  330.     (and (= ?\\ char) (< pos len) (or (memq (setq char (aref command pos))
  331.                         dired-shell-command-separators)
  332.                       (= ?\\ char))
  333.          (setq pos (1+ pos))))
  334.       (setq transform (if (= start pos)
  335.               ""
  336.             (dired-trans-filenames (substring command start pos)
  337.                            files dir))
  338.         ;; remember if we did any transforming
  339.         transed (or transed (listp transform))
  340.         result (concat result
  341.                (substring command last start)
  342.                (if (listp transform)
  343.                    (car transform)
  344.                  transform))
  345.         last pos))
  346.     (if transed
  347.     ;; just return result
  348.     result
  349.       ;; add the filenames at the end.
  350.       (let ((fns (if (> (length files) 1)
  351.              (concat dired-shell-prefix
  352.                  (mapconcat
  353.                   (function
  354.                    (lambda (fn)
  355.                  (dired-shell-quote
  356.                   (dired-make-relative fn dir t))))
  357.                   files dired-shell-separator)
  358.                  dired-shell-postfix)
  359.            (dired-shell-quote
  360.             (dired-make-relative (car files) dir t)))))
  361.     (concat result " " fns)))))
  362.  
  363. (defun dired-shell-stuff-it (command file-list dir on-each)
  364.   ;; Make up a shell command line from COMMAND and FILE-LIST.
  365.   ;; If ON-EACH is t, COMMAND should be applied to each file, else
  366.   ;; simply concat all files and apply COMMAND to this.
  367.   ;; If ON-EACH is 'dir, the command is run in the directory of each file
  368.   ;; In this case FILE-LIST must be a list of full paths.
  369.   ;; FILE-LIST's elements will be quoted for the shell.
  370.   (cond
  371.    ((eq on-each 'dir)
  372.     (let ((subshell-dir nil)
  373.       (list file-list)
  374.       (result nil))
  375.       (while list
  376.     (let ((cmd (dired-trans-command command (list (car list))
  377.                     (file-name-directory (car list))))
  378.           (fdir (dired-shell-quote (file-name-directory (car list)))))
  379.       (setq result
  380.         (apply 'concat
  381.                result
  382.                (if subshell-dir
  383.                (if (string-equal dir subshell-dir)
  384.                    (list "\; " cmd)
  385.                  (if (string-equal dir fdir)
  386.                  (progn
  387.                    (setq subshell-dir nil)
  388.                    (list "\)\; " cmd))
  389.                    (setq subshell-dir fdir)
  390.                    (list "\)\; \(cd "
  391.                      fdir
  392.                      "\; "
  393.                      cmd)))
  394.              (if (string-equal fdir dir)
  395.                  (list (and result "\; ")
  396.                    cmd)
  397.                (setq subshell-dir fdir)
  398.                (list (and result "\; ")
  399.                  "\(cd "
  400.                  fdir
  401.                  "\; "
  402.                  cmd)))))
  403.       (setq list (cdr list))))
  404.       (concat result (and subshell-dir ")"))))
  405.    (on-each
  406.     (mapconcat (function
  407.         (lambda (fn)
  408.           (dired-trans-command command (list fn) dir)))
  409.            file-list "; "))
  410.    
  411.    (t (dired-trans-command command file-list dir))))
  412.  
  413. (defun dired-guess-default (files)
  414.   ;; Guess a list of possible shell commands for FILES.
  415.   (and dired-default-auto-shell-command-alist
  416.        files
  417.        (let ((alist (append dired-auto-shell-command-alist
  418.                 dired-default-auto-shell-command-alist))
  419.          guesses)
  420.      (while alist
  421.        (let* ((elt (car alist))
  422.           (regexp (car elt)))
  423.          (setq guesses
  424.            (nconc guesses
  425.               (catch 'missed
  426.                 (mapcar (function
  427.                      (lambda (file)
  428.                        (or (string-match regexp file)
  429.                        (throw 'missed nil))))
  430.                     files)
  431.                 (delq nil (mapcar 'eval (cdr elt)))))))
  432.        (setq alist (cdr alist)))
  433.      (dired-uniquefy-list guesses))))
  434.  
  435. (defun dired-shell-unhandle-file-name (filename)
  436.   "Turn a file name into a form that can be sent to a shell process.
  437. This is particularly usefull if we are sending file names to a remote shell."
  438.   (let ((handler (find-file-name-handler filename 'dired-shell-unhandle-file-name)))
  439.     (if handler
  440.     (funcall handler 'dired-shell-unhandle-file-name filename)
  441.       filename)))
  442.  
  443. ;;; Actually running the shell command
  444.  
  445. (defun dired-run-shell-command-closeout (buffer &optional message)
  446.   ;; Report on the number of lines produced by a shell command.
  447.   (if (get-buffer buffer)
  448.       (save-excursion
  449.     (set-buffer buffer)
  450.     (if (zerop (buffer-size))
  451.         (progn
  452.           (if message
  453.           (message "Shell command completed with no output. %s"
  454.                  message)
  455.         (message "Shell command completed with no output."))
  456.           (kill-buffer buffer))
  457.       (set-window-start (display-buffer buffer) 1)
  458.       (if message
  459.           (message "Shell command completed. %s" message)
  460.         (message "Shell command completed."))))))
  461.  
  462. (defun dired-rsc-filter (proc string)
  463.   ;; Do save-excursion by hand so that we can leave point
  464.   ;; numerically unchanged despite an insertion immediately
  465.   ;; after it.
  466.   (let* ((obuf (current-buffer))
  467.      (buffer (process-buffer proc))
  468.      opoint
  469.      (window (get-buffer-window buffer))
  470.      (pos (window-start window)))
  471.     (unwind-protect
  472.     (progn
  473.       (set-buffer buffer)
  474.       (setq opoint (point))
  475.       (goto-char (point-max))
  476.       (insert-before-markers string))
  477.       ;; insert-before-markers moved this marker: set it back.
  478.       (set-window-start window pos)
  479.       ;; Finish our save-excursion.
  480.       (goto-char opoint)
  481.       (set-buffer obuf))))
  482.  
  483. (defun dired-rsc-sentinel (process signal)
  484.   ;; Sentinel function used by dired-run-shell-command
  485.   (if (memq (process-status process) '(exit signal))
  486.       (let ((buffer (get-buffer (process-buffer process))))
  487.     (if buffer
  488.         (save-excursion
  489.           (set-buffer buffer)
  490.           (if (zerop (buffer-size))
  491.           (message
  492.            "Dired & shell command completed with no output.")
  493.         (let ((lines (count-lines dired-shell-input-start
  494.                       (point-max))))
  495.           (message
  496.            "Dired & shell command completed with %d line%s of output."
  497.                    lines (dired-plural-s lines))))
  498.           (setq mode-line-process nil)))
  499.     (delete-process process))))
  500.  
  501. (defun dired-shell-call-process (command dir &optional in-background)
  502.   ;; Call a shell command as a process in the current buffer.
  503.   ;; The process should try to run in DIR.  DIR is also
  504.   ;; used to lookup a file-name-handler.
  505.   ;; Must return the process object if IN-BACKGROUND is non-nil,
  506.   ;; otherwise the process exit status.
  507.   (let ((handler (find-file-name-handler dir 'dired-shell-call-process)))
  508.     (if handler
  509.     (funcall handler 'dired-shell-call-process command dir in-background)
  510.       (let ((process-connection-type ; don't waste pty's
  511.          (null (null in-background))))
  512.     (setq default-directory dir)
  513.     (if in-background
  514.         (progn
  515.           (setq mode-line-process '(": %s"))
  516.           (start-process "Shell" (current-buffer)
  517.                  shell-file-name "-c" command))
  518.       (call-process shell-file-name nil t nil "-c" command))))))
  519.  
  520. (defun dired-run-shell-command (command dir in-background &optional append)
  521.   ;; COMMAND is shell command
  522.   ;; DIR is directory in which to do the shell command.
  523.   ;; If IN-BACKGROUND is non-nil, the shell command is run in the background.
  524.   ;;   If it is a string, this is written as header into the output buffer
  525.   ;;   before the command is run.
  526.   ;; If APPEND is non-nil, the results are appended to the contents
  527.   ;;   of *shell-command* buffer, without erasing its previous contents.
  528.   (save-excursion
  529.     (if in-background
  530.     (let* ((buffer (get-buffer-create
  531.                "*Background Shell Command Output*"))
  532.            (n 2)
  533.            proc)
  534.       ;; No reason why we can't run two+ background commands.
  535.       (while (get-buffer-process buffer)
  536.         (setq buffer (get-buffer-create
  537.               (concat "*Background Shell Command Output*<"
  538.                   (int-to-string n) ">"))
  539.           n (1+ n)))
  540.       (set-buffer buffer)
  541.       (or (eq major-mode 'comint-mode)
  542.           (progn
  543.         (comint-mode)
  544.         (set (make-local-variable 'comint-prompt-regexp)
  545.              "^[^\n]*\\? *")))
  546.       (display-buffer buffer)
  547.       (barf-if-buffer-read-only)
  548.       ;; If will kill a process, query first.
  549.  
  550.       (set (make-local-variable 'dired-shell-input-start) (point-min))
  551.       (if append
  552.           (progn
  553.         (goto-char (point-max))
  554.         (or (= (preceding-char) ?\n) (bobp) (insert "\n")))
  555.         (erase-buffer)
  556.         (if (stringp in-background)
  557.         (progn
  558.           (insert in-background)
  559.           (set (make-local-variable 'dired-shell-input-start)
  560.                (point)))))
  561.       (setq proc (dired-shell-call-process command dir t))
  562.       (set-marker (process-mark proc) (point))
  563.       (set-process-sentinel proc 'dired-rsc-sentinel)
  564.       (set-process-filter proc 'dired-rsc-filter)
  565.       nil) ; return
  566.       (let ((buffer (get-buffer-create "*Shell Command Output*")))
  567.     (set-buffer buffer)
  568.     (barf-if-buffer-read-only)
  569.     (set (make-local-variable 'dired-shell-input-start) (point-min))
  570.     (if append
  571.         (progn
  572.           (goto-char (point-max))
  573.           (or (= (preceding-char) ?\n) (bobp) (insert "\n")))
  574.       (erase-buffer))
  575.     (dired-shell-call-process command dir)))))
  576.  
  577. ;;; User commands
  578.  
  579. (defun dired-do-shell-command (command arg files &optional in-background)
  580.   ;; ARG = (16) means operate on each file, in its own directory.
  581.   ;; ARG = (4) means operate on each file, but in the current
  582.   ;;       default-directory.
  583.   "Run a shell command COMMAND on the marked files.
  584. If no files are marked or a non-zero numeric prefix arg is given,
  585. the next ARG files are used.  Use prefix 1 to indicate the current file.
  586.  
  587. Normally the shell command is executed in the current dired subdirectory.
  588. This is the directory in the dired buffer which currently contains the point.
  589. One shell command is run for all of the files.
  590. e.g. cmd file1 file2 file3 ... 
  591. If the total length of of the command exceeds 10000 characters, the files will
  592. be bunched to forms commands shorter than this length, and successive commands
  593. will be sent.
  594.  
  595. With a prefix of \\[universal-argument], a separate command for each file will
  596. be executed.
  597.  
  598. With a prefix of \\[universal-argument] \\[universal-argument], a separate command will be sent for each file,
  599. and the command will be executed in the directory of that file.  The explicit
  600. command will be of the form 
  601.  
  602.                       cd dir; cmd file
  603.  
  604. When prompting for the shell command, dired will always indicate the directory
  605. in which the command will be executed.
  606.  
  607. The following documentation depends on the settings of `dired-file-wildcard',
  608. `dired-shell-command-separators', `dired-trans-map', `dired-shell-prefix',
  609. `dired-shell-separator', and `dired-shell-postfix'. See the documentation for
  610. these variables. Below, I will assume default settings for these variables.
  611.  
  612. If the shell command contains a *, then the list of files is substituted for *.
  613. The filenames will be written as relative to the directory in which the shell
  614. command is executing. If there is no *, and the command does not end in &, 
  615. then the files are appended to the end of the command. If the command ends in
  616. a &, then the files are inserted before the &.
  617.  
  618. If `dired-use-file-transformers' is non-nil, then certain 2-character
  619. sequences represent parts of the file name.
  620. The default transformers are:
  621. *f = full file name
  622. *n = file name without directory
  623. *d = file name's directory 
  624.      This will end in a \"/\" in unix.
  625. *e = file names extension
  626.      By default this the part of the file name without directory, which
  627.      proceeds the first \".\". If \".\" is the first character of the name,
  628.      then this \".\" is ignored. The definition of extension can
  629.      be customized with `dired-filename-re-ext'.
  630. *b = file base name
  631.      This is the part of the file name without directory that precedes
  632.      the extension.
  633. *v = file name with out version control extension (i.e. \",v\")
  634. *z = file name without compression extension
  635.      (i.e. \".Z\", \".z\", or \".gz\")
  636.  
  637. Shell commands are divided into words separated by spaces. Then for each
  638. word the file name transformers are applied to the list of files, the result
  639. concatenated together and substituted for the word in the shell command.
  640.  
  641. For example
  642.    cmd -a *f -b *d*b.fizzle applied to /foo/bar and /la/di/da results in
  643.    cmd -a /foo/bar /la/di/da -b /foo/bar.fizzle /la/di/da.fizzle
  644.  
  645. The \"on-each\" prefixes \\[universal-argument] and 0, also apply while
  646. using file transformers. As well, when using file-transformers * still
  647. represents the file name relative to the current directory. Not that this
  648. differs from *f, which always represents the full pathname.
  649.  
  650. A \"\\\" can always be used to quote any character having special meaning.
  651. For example, if the current directory is /la, then *n applied
  652. to /la/di/da returns la, whereas *\\n returns di/dan. Similarly,
  653. \"*d\\ *n\" returns \"/la/di da\".
  654.  
  655. The prefix character for file name transformers is always the same as
  656. `dired-file-wildcard'."
  657.  
  658.   (interactive
  659.    (let ((on-each (or (equal '(4) current-prefix-arg)
  660.               (equal '(16) current-prefix-arg)))
  661.      (files (dired-get-marked-files
  662.          nil (and (not (consp current-prefix-arg))
  663.               current-prefix-arg)))
  664.      (dir (and (not (equal current-prefix-arg '(16)))
  665.            (dired-current-directory))))
  666.      (list
  667.       (dired-read-shell-command
  668.        (concat (if dir
  669.            (format "! in %s " (dired-abbreviate-file-name dir))
  670.          "cd <dir>; ! ")
  671.            "on "
  672.            (if on-each "each ")
  673.            "%s: ")
  674.        (and (not on-each) current-prefix-arg)
  675.        (if dir
  676.        (mapcar (function
  677.             (lambda (fn)
  678.               (dired-make-relative fn dir t)))
  679.            files)
  680.      files))
  681.       current-prefix-arg files nil)))
  682.  
  683.   ;; Check for background commands
  684.   (if (string-match "[ \t]*&[ \t]*$" command)
  685.       (setq command (substring command 0 (match-beginning 0))
  686.         in-background t))
  687.  
  688.   ;; Look out for remote file names.
  689.   
  690.   (let* ((on-each (or (equal arg '(4)) (and (equal arg '(16)) 'dir)))
  691.      (ufiles (mapcar 'dired-shell-unhandle-file-name files))
  692.      (dir (dired-current-directory))
  693.      (udir (dired-shell-unhandle-file-name dir)))
  694.  
  695.     (save-excursion ; in case `shell-command' changes buffer
  696.       (cond
  697.  
  698.        ((null ufiles)
  699.     ;; Just run as a command on no files.
  700.     (if in-background
  701.         (dired-run-shell-command command dir t)
  702.       (dired-run-shell-command command dir nil)
  703.       (dired-run-shell-command-closeout "*Shell Command Output*")))
  704.     
  705.        (in-background
  706.     ;; Can't use dired-bunch-files for background shell commands.
  707.     ;; as we will create a bunch of process running simultaneously.
  708.     ;; A better solution needs to be found.
  709.     (dired-run-shell-command
  710.      (dired-shell-stuff-it command ufiles udir on-each)
  711.      dir (if (equal arg '(16))
  712.          (concat "cd <dir>; \"" command "\"\n\n")
  713.            (concat "\"" command "\" in " dir "\n\n"))))
  714.        (on-each
  715.     (let ((buff (get-buffer "*Shell Command Output*"))
  716.           failures this-command this-dir ufile return message)
  717.       (if buff
  718.           (save-excursion
  719.         (set-buffer buff)
  720.         (erase-buffer)))
  721.       (while ufiles
  722.         (setq ufile (car ufiles))
  723.         (if (eq on-each 'dir)
  724.         (setq this-dir (dired-shell-quote (file-name-directory (directory-file-name ufile)))
  725.               this-command (concat "cd " this-dir "; " command))
  726.           (setq this-command command)
  727.           (or this-dir (setq this-dir udir)))
  728.         (setq return
  729.           (dired-run-shell-command
  730.            (dired-shell-stuff-it this-command (list ufile) this-dir nil)
  731.            this-dir nil t))
  732.         (if (and (integerp return) (/= return 0))
  733.         (save-excursion
  734.           (let ((file (nth (- (length files) (length (member ufile ufiles))) files)))
  735.             (if (and dired-shell-failure-marker
  736.                  (dired-goto-file file))
  737.             (let ((dired-marker-char dired-shell-failure-marker))
  738.               (dired-mark 1)))
  739.             (setq failures (cons file failures)))))
  740.         (setq ufiles (cdr ufiles)))
  741.       (if failures
  742.           (let ((num (length failures)))
  743.         (setq message
  744.               (if dired-shell-failure-marker
  745.               (format
  746.                "Marked %d failure%s with %c."
  747.                num (dired-plural-s num)
  748.                dired-shell-failure-marker)
  749.             "Failed on %d file%s." num
  750.             (dired-plural-s num)))
  751.         (dired-log
  752.          (current-buffer)
  753.          "Shell command %s failed (non-zero exit status) for:\n  %s"
  754.          command failures)
  755.         (dired-log (current-buffer) t)))
  756.       (dired-run-shell-command-closeout "*Shell Command Output*" message)))
  757.     
  758.        (t
  759.     (dired-bunch-files
  760.      (- 10000 (length command))
  761.      (function (lambda (&rest ufiles)
  762.              (dired-run-shell-command
  763.               (dired-shell-stuff-it command ufiles udir nil)
  764.               dir nil)
  765.              nil)) ; for the sake of nconc in dired-bunch-files
  766.      nil ufiles)
  767.     (dired-run-shell-command-closeout "*Shell Command Output*"))))
  768.     ;; Update any directories
  769.     (or in-background
  770.     (let ((dired-no-confirm '(revert-subdirs)))
  771.       (dired-verify-modtimes)))))
  772.  
  773. (defun dired-do-background-shell-command (command arg files)
  774.   "Like \\[dired-do-shell-command], but starts command in background.
  775. Note that you can type input to the command in its buffer.
  776. This requires background.el from the comint package to work."
  777.   ;; With the version in emacs-19.el, you can alternatively just
  778.   ;; append an `&' to any shell command to make it run in the
  779.   ;; background, but you can't type input to it.
  780.   (interactive
  781.    (let ((on-each (or (equal '(4) current-prefix-arg)
  782.               (equal '(16) current-prefix-arg)))
  783.      (files (dired-get-marked-files
  784.          nil (and (not (consp current-prefix-arg))
  785.               current-prefix-arg)))
  786.      (dir (and (not (equal current-prefix-arg '(16)))
  787.            (dired-current-directory))))
  788.      (list
  789.       (dired-read-shell-command
  790.        (concat "& "
  791.            (if dir
  792.            (format "in %s " (dired-abbreviate-file-name dir))
  793.          "cd <dir>; ")
  794.            "on "
  795.            (if on-each "each ")
  796.            "%s: ")
  797.        (and (not on-each) current-prefix-arg)
  798.        (if dir
  799.        (mapcar (function
  800.             (lambda (fn)
  801.               (dired-make-relative fn dir t)))
  802.            files)
  803.      files))
  804.       current-prefix-arg files)))
  805.   (dired-do-shell-command command arg files t))
  806.  
  807. ;;; Printing files
  808.  
  809. (defun dired-do-print (&optional arg command files)
  810.   "Print the marked (or next ARG) files.
  811. Uses the shell command coming from variable `dired-print-program-alist'."
  812.   (interactive
  813.    (progn
  814.      (if dired-print-history
  815.      (setq dired-print-history (dired-uniquefy-list dired-print-history))
  816.        (setq dired-print-history (mapcar 'cdr dired-print-program-alist)))
  817.      (let* ((files (dired-get-marked-files nil current-prefix-arg))
  818.         (rel-files (mapcar (function
  819.                 (lambda (fn)
  820.                   (dired-make-relative
  821.                    fn
  822.                    (dired-current-directory) t)))
  823.                    files))
  824.         (alist dired-print-program-alist)
  825.         (first (car files))
  826.         (dired-print-history (copy-sequence dired-print-history))
  827.         elt initial command)
  828.        ;; For gmhist
  829.        (put 'dired-print-history 'no-default t)
  830.        (if first
  831.        (while (and alist (not initial))
  832.          (if (string-match (car (car alist)) first)
  833.          (setq initial (cdr (car alist)))
  834.            (setq alist (cdr alist)))))
  835.        (if (and initial (setq elt (member initial dired-print-history)))
  836.        (setq dired-print-history (nconc
  837.                       (delq (car elt) dired-print-history)
  838.                       (list initial))))
  839.        (setq command
  840.          (dired-mark-read-string
  841.           "Print %s with: "
  842.           initial 'print current-prefix-arg rel-files
  843.           'dired-print-history))
  844.        (list current-prefix-arg command files))))
  845.   (or files
  846.       (setq files (dired-get-marked-files nil arg)))
  847.   (while files
  848.     (dired-print-file command (car files))
  849.     (setq files (cdr files))))
  850.  
  851. (defun dired-print-file (command file)
  852.   ;; Using COMMAND, print FILE.
  853.   (let ((handler (find-file-name-handler file 'dired-print-file)))
  854.     (if handler
  855.     (funcall handler 'dired-print-file command file)
  856.       (let ((rel-file (dired-make-relative file (dired-current-directory) t)))
  857.     (message "Spooling %s..." rel-file)
  858.     (shell-command (dired-trans-command command (list file) ""))
  859.     (message "Spooling %s...done" rel-file)))))
  860.  
  861. ;;; end of dired-shell.el
  862.